(defun display-tuple (x)
  (format t x))
(defun make-tuple-series (b e st)
  "Make tuple with a series of number begin with b end with e step st"
  (if (> b e)
      (loop for i from b downto e by st
	 collect i)
      (loop for i from b to e by st
	 collect i)
      ))
(defun make-tuple-one (n &optional init)
  (if init
      (loop repeat n collect init)
      (loop repeat n collect 1)
      )
  )
(defun make-root-A (n i &optional j)
  (if j
      (let ((v (make-tuple-zero (+ n 1))))
	(setf (nth (- i 1) v) 1)
	(setf (nth (- j 1) v) -1)
	v)
      (make-root-A n i (+ i 1))
      ))
(defun make-2rho-A (n)
  (make-tuple-series n (- n) 2))
(defun make-rho-A (n)
  (make-tuple-series (/ n 2) (/ (- n) 2) 1))
(defun lazy (x) 
  (lambda () x))
(defun add-root (&rest a)
  (apply #'mapcar (cons #'+ a))
  )
(defun add-root-num (root n)
  (mapcar #'(lambda (x) (+ n x)) root)
  )
(defun mult-root-num (root n)
  (mapcar #'(lambda (x) (* n x)) root)
  )
(defun connect-roots (&rest a)
  (apply #'append a)
)

(defun prod-roots (a b)
  (loop for i in a 
     and j in b
     summing (* i j) into total
     finally (return total) 
       ))
(defun prod-coroots (a b)
  (/ (* 2 (prod-roots a b))
     (prod-roots b b)))
  
(defun highest-wt-su (p q lam0)
  "Highest weight module"
  (let* ((n (+ p q))
	 (xi (connect-roots (make-tuple-one p (/ q n))
			    (make-tuple-one q (- (/ p n)))))
	 (rho (make-rho-A (- n 1)))
	 (beta (make-root-A (- n 1) 1 n))
	 ;; make lambda0 normalized
	 (lam00 (let ((zz  (- (/ (prod-coroots (add-root lam0 rho) 
					       beta)
				 (prod-coroots xi beta)))))
		  (add-root lam0 (mult-root-num xi zz))
		  ))
	 )
    (format t "~%xi")
    (pprint xi)
    (format t "~%rho")
    (pprint rho)
    (format t "~%beta")
    (pprint beta)
    (format t "~%lam0")
    (pprint lam00)
    ))

(defun test-su (p q)
  (let* ((n (+ p q))
	 (lam0 (make-tuple-one (+ p q) 0)))
    (highest-wt-su p q lam0)
    ))
